home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / basic / bardcol2.zip / BARDCOL2.INC < prev   
Text File  |  1991-09-08  |  5KB  |  186 lines
  1. 'All Routines in this file were written by Dave Navarro
  2.  
  3. 'GetKey - Loop until a key is pressed and return the key to your program
  4.  
  5. FUNCTION Getkey$ PUBLIC
  6.    WHILE I$=""
  7.       I$=INKEY$
  8.    WEND
  9.    Getkey$=I$
  10. END FUNCTION
  11.  
  12. 'ScrollDN - Scroll a specified part of the screen down
  13.  
  14. SUB ScrollDN (LC%, RC%, TR%, BR%, Rows%, Atr%) PUBLIC
  15.    REG 1, Rows%+256*7
  16.    REG 2, Atr%*256
  17.    REG 3, (LC%-1)+256*(TR%-1)
  18.    REG 4, (RC%-1)+256*(BR%-1)
  19.    CALL INTERRUPT &h10
  20. END SUB
  21.  
  22. 'ScrollUp - Scroll a specified part of the screen up
  23.  
  24. SUB ScrollUp (LC%, RC%, TR%, BR%, Rows%, Atr%) PUBLIC
  25.    REG 1, Rows%+256*6
  26.    REG 2, Atr%*256
  27.    REG 3, (LC%-1)+256*(TR%-1)
  28.    REG 4, (RC%-1)+256*(BR%-1)
  29.    CALL INTERRUPT &h10
  30. END SUB
  31.  
  32. 'GetScrn$ - Get a portion of the screen and put it in a string
  33.  
  34. FUNCTION GetScrn$(Ypos%,Xpos%,Ylen%) PUBLIC
  35.     DEF SEG=VidAddr%
  36.     GetScrn$=PEEK$((Ypos%-1)*160+(Xpos%-1)*2,Ylen%*2)
  37.     DEF SEG
  38. END FUNCTION
  39.  
  40. 'PutScrn - Put a string saved with FNGetScrn back onto the screen
  41.  
  42. SUB PutScrn(Ypos%, Xpos%, Temp$) PUBLIC
  43.     DEF SEG=VidAddr%
  44.     POKE$ (Ypos%-1)*160+(Xpos%-1)*2, Temp$
  45.     DEF SEG
  46. END SUB
  47.  
  48. 'VidAddr - Returns segment of video address
  49.  
  50. FUNCTION VidAddr% PUBLIC
  51.    DEF SEG=0
  52.      Videotmp%=PEEK(&h449)
  53.      IF Videotmp%=7 THEN Videotmp%=&hB000 ELSE Videotmp%=&hB800
  54.      DEF SEG
  55.    VidAddr%=Videotmp%
  56. END FUNCTION
  57.  
  58. 'CurDrive% - Returns current logged drive
  59.  
  60. FUNCTION CurDrive% PUBLIC
  61.    CurDrive%=ASC(CurDir$)-64
  62. END FUNCTION
  63.  
  64. 'Exist - Returns true if file exists
  65.  
  66. FUNCTION Exist%(File$) PUBLIC
  67.    ON ERROR GOTO NoFile
  68.    Tmp$=DIR$(File$,&H17)
  69.    IF Tmp$<>"" THEN Exist%=-1
  70.    EXIT FUNCTION
  71.    NoFile:
  72.      RESUME NEXT
  73.      ON ERROR GOTO 0
  74.      Exist%=0
  75. END FUNCTION
  76.  
  77. 'GetDosV% - Returns DOS version number, Example: 3.3 = 330
  78.  
  79. FUNCTION GetDosV% PUBLIC
  80.     REG 1, &h3000
  81.     CALL INTERRUPT &h21
  82.     Ver%=REG(1)/256
  83.     MVer%=REG(1)-(Ver%*256)
  84.     GetDosV%=MVer%*100+Ver%
  85. END FUNCTION
  86.  
  87. 'DrvSpace# - Double precision integer containing free bytes on default drive
  88.  
  89. FUNCTION DrvSpace# PUBLIC
  90.     REG 1, &h3600
  91.     REG 4, 0
  92.     CALL INTERRUPT &h21
  93.     SecPC#=REG(1)              ' Sectors per cluster
  94.     FrCl#=REG(2)               ' Free clusters
  95.     BytPS#=REG(3)              ' Bytes per sector
  96.     DrvSpace#=(FrCl#*(SecPC#*BytPS#))
  97. END FUNCTION
  98.  
  99. 'FileCount% - report the number of files with Atr% attributes in Path$
  100.  
  101. FUNCTION FileCount%(Path$,Atr%) PUBLIC
  102.    Tmp$=DIR$(Path$,Atr%)
  103.    IF Tmp$="" THEN
  104.       FileCount%=0
  105.       EXIT FUNCTION
  106.    END IF
  107.    Count%=1
  108.    MoreFiles:
  109.       Tmp$=DIR$
  110.       IF Tmp$<>"" THEN INCR Count%:GOTO MoreFiles
  111.    FileCount%=Count%
  112. END FUNCTION
  113.  
  114. 'GetDir - Return filenames in Dir Path$ in an array
  115.  
  116. SUB GetDir(Path$,Atr%,TDir$()) PUBLIC
  117.    TDir$(1)=Expand$(DIR$(Path$,Atr%))
  118.    IF TDir$(1)="" THEN EXIT SUB
  119.    Count%=2
  120.    MorFiles:
  121.     TDir$(Count%)=Expand$(DIR$)
  122.       IF TDir$(Count%)="" OR Count%=UBOUND(TDIR$(1)) THEN Sortem
  123.       INCR Count%
  124.       GOTO MorFiles
  125.    SortEm:
  126.       ARRAY SORT TDir$()
  127. END SUB
  128.  
  129. 'VLabel - Returns Volume Label
  130.  
  131. FUNCTION VLabel$ PUBLIC
  132.    VLabel$=DIR$("*.*",8)
  133. END FUNCTION
  134.  
  135. 'SetDrive - Log to another drive, 1 = A:, 2 = B:, etc...
  136.  
  137. SUB SetDrive(Drive%) PUBLIC
  138.     REG 1, &h0E00
  139.     REG 4, Drive%-1
  140.     CALL INTERRUPT &h21
  141. END SUB
  142.  
  143. 'Atrb - Return a printable string describing a files attributes
  144.  
  145. FUNCTION Atrb$(X$) PUBLIC
  146.   X$=NoSpace$(X$)
  147.   IF X$="" OR X$="." OR RIGHT$(X$,1)="\" OR RIGHT$(X$,3)="\.." THEN EXIT FUNCTION
  148.   X%=ATTRIB(X$)
  149.   IF (X% AND 1)=1 THEN Tmp$=Tmp$+"R" ELSE Tmp$=Tmp$+"."
  150.   IF (X% AND 2)=2 THEN Tmp$=Tmp$+"H" ELSE Tmp$=Tmp$+"."
  151.   IF (X% AND 4)=4 THEN Tmp$=Tmp$+"S" ELSE Tmp$=Tmp$+"."
  152.   IF (X% AND 32)=32 THEN Tmp$=Tmp$+"A" ELSE Tmp$=Tmp$+"."
  153.   Atrb$=Tmp$
  154. END FUNCTION
  155.  
  156. 'Attrb - Turns a printable string containing attributes into an integer
  157.  
  158. FUNCTION Attrb%(Atr$) PUBLIC
  159.    Atr$=UCASE$(Atr$)
  160.    IF INSTR(Atr$,"A") THEN Tmp%=Tmp%+32
  161.    IF INSTR(Atr$,"R") THEN Tmp%=Tmp%+1
  162.    IF INSTR(Atr$,"H") THEN Tmp%=Tmp%+2
  163.    IF INSTR(Atr$,"S") THEN Tmp%=Tmp%+4
  164.    Attrb%=Tmp%
  165. END FUNCTION
  166.  
  167. 'Path - Finds a file if it is in the path, and returns it's full pathname
  168.  
  169. FUNCTION ChkPath$(F$) PUBLIC
  170.   IF INSTR(F$,"*")>0 OR INSTR(F$,"?")>0 THEN EXIT FUNCTION
  171.   IF F$="" THEN EXIT FUNCTION
  172.   A$=UCASE$(ENVIRON$("PATH"))
  173.   WHILE INSTR(A$,";")
  174.     B$=LEFT$(A$,INSTR(A$,";")-1)
  175.     A$=MID$(A$,INSTR(A$,";")+1)
  176.     IF RIGHT$(B$,1)="\" THEN B$=LEFT$(B$,LEN(B$)-1)
  177.     IF DIR$(B$,16)="" THEN SkipMe
  178.     IsPath%=Exist%(B$+"\"+F$)
  179.     IF IsPath% THEN ChkPath$=B$+"\"+F$:EXIT FUNCTION
  180.     SkipMe:
  181.   WEND
  182.   IF RIGHT$(A$,1)="\" THEN A$=LEFT$(A$,LEN(A$)-1)
  183.   IF Exist%(A$+"\"+F$) THEN ChkPath$=A$+"\"+F$
  184. END FUNCTION
  185.  
  186.